home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Demos / Widget / Wbitmap.stklos < prev    next >
Encoding:
Text File  |  1995-09-16  |  912 b   |  28 lines
  1. ;;;;
  2. ;;;; STk adaptation of the Tk widget demo.
  3. ;;;;
  4. ;;;; This demonstration script creates a toplevel window that displays
  5. ;;;; all of Tk's built-in bitmaps.
  6. ;;;;
  7. (require "Tk-classes")
  8.  
  9. (define (demo-bitmap)
  10.   (define w (make-demo-toplevel "bitmap"
  11.                 "Bitmap Demonstration"
  12.                 "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts."))
  13.  
  14.   (define (bitmap-row l)
  15.     (let ((f (make <Frame> :parent w)))
  16.       (pack f :side "top" :fill "both")
  17.       (for-each (lambda (bitmap)
  18.           (let ((f2 (make <Frame> :parent f)))
  19.             (pack f2 :side "left" :fill "both" :padx '.25c :pady '.25c)
  20.             (pack (make <Label> :parent f2 :bitmap bitmap)
  21.               (make <Label> :parent f2 :text bitmap :width 9)
  22.               :side "bottom")))
  23.         l)))
  24.   
  25.   ;; Display two rows of bitmaps
  26.   (bitmap-row '(error gray25 gray50 hourglass))
  27.   (bitmap-row '(info question questhead warning)))
  28.